home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / FORTH / FORTHMAC / OLD / TOOLS1 / !Forthmacs.lib.arm.debug < prev    next >
Encoding:
Text File  |  1996-05-30  |  5.1 KB  |  129 lines
  1. \ This debugger is better adapted to the risc_os environment.
  2. \ uses text-environment debugger window
  3.  
  4. \ Debugger.  Thanks, Mike Perry, Henry Laxen, Mark Smeder.
  5. \
  6. \ The debugger lets you single step the execution of a high level
  7. \ definition.  To invoke the debugger, type debug xxx where xxx is
  8. \ the name of the word you wish to trace.  When xxx executes, you will
  9. \ get a single step trace showing you the word within xxx that
  10. \ is about to execute, and the contents of the parameter stack.
  11. \ Debugging makes everything run slightly slower, even outside
  12. \ the word being debugged.  see debug-off
  13. \
  14. \ debug name    Mark that word for debugging
  15. \ step          Debug in single step mode
  16. \ trace         Debug in trace mode
  17. \ debug-off     Turn off the debugger (makes the system run fast again)
  18. \ resume        Exit from a pushed interpreter (see the f keystroke)
  19. \
  20. \ Keystroke commands while you're single-stepping:
  21. \   d           go down a level
  22. \   u           go up a level
  23. \   c           continue; trace without single stepping
  24. \   g           go; turn off stepping and continue execution
  25. \   f           push a Forth interpreter;  execute "resume" to get back
  26. \   q           abort back to the top level
  27.  
  28. only forth also  hidden also  bug also definitions
  29.  
  30. : interpret-line  \ input-line ( -- ?? )
  31.         0 0 0 0 0   prompt  2drop 2drop drop         \ Hack to make showstack work
  32.         astring dup char+ 80 expect  span @ over c!  count evaluate ;
  33. hex
  34.  
  35. variable slow-next?  slow-next? off
  36. variable used-window            \ points to pfa of used window
  37. create vid-par 16 allot
  38.  
  39. : set-used-window       \ ( -- )
  40.                 used-window @ 2@  used-window @ 2 cells+ 2@ (window
  41.                 used-window @ 4 cells+ 2@ at-xy ;
  42. : window                \ name ( x-left y-bot x-right y-top -- )
  43.         create  2>r , ,  2r> , ,  ( cursor position ) 0 ,  0 ,
  44.         does>   \ first save old window
  45.                 dup used-window @ = if drop exit then
  46.                 used-window @ if at-xy? used-window @ 4 cells+ 2! then
  47.                 used-window !
  48.                 set-used-window ;
  49.  
  50. lcol trow 12 +    rcol 1-  trow        window debugger-window
  51. lcol brow       rcol 1-  trow 14 +    window forth-window
  52.  
  53. : -line         ( -- )  #columns 1- #out @ - 0 max 0 ?do [char] - emit loop ;
  54. : one-window    ( -- )  vid-par 2 cells+ 2@  vid-par 2@ (window ;
  55.  
  56. variable last-string
  57. : .dinfo        \ ( str -- )
  58.         dup last-string @ = if drop exit then
  59.         dup last-string !
  60.         at-xy? rot one-window 0 13 at-xy  marked ." -- " ". space -line light
  61.         set-used-window at-xy ;
  62.  
  63. : .dtitle       p" RISC OS Forthmacs debugger" .dinfo ;
  64. : .dkeyinfo     p" [<space> Down Up Continue Forth Go Quit]" .dinfo ;
  65. : .dcont        p" [ <any key> to stop ]" .dinfo ;
  66. : .dresume      p" > resume < restarts debugger" .dinfo ;
  67.  
  68. : two-windows
  69.         (get-window vid-par 2!  vid-par 2 cells+ 2!
  70.         erase-screen .dtitle  forth-window ;
  71.  
  72. variable step? step? on
  73. variable res
  74. : (debug)       (s low-adr hi-adr -- )
  75.         \ Silently refuse to debug the kernel; it's too dangerous
  76.         over  low-dictionary-adr ( fence @ ) ['] alias between  if 2drop exit then
  77.         unbug   1 cnt !   ip> !   <ip !   pnext
  78.         slow-next? @ 0=
  79.         if      ['] forth  low-dictionary-adr slow-next
  80.                 two-windows  slow-next? on
  81.         then abort ;
  82. : 'unnest       (s pfa -- pfa' )
  83.         begin #align + dup token@ ['] unnest =  until ;
  84.  
  85. \ Enter and leave the debugger
  86. variable save-status
  87. variable linecounter
  88. : (debug        ( acf -- )
  89.         ['] status >data token@ save-status token!
  90.         /token -   dup 'unnest  (debug) ;
  91. : up1           ( ip -- )
  92.         dup find-cfa swap 'unnest (debug) ;
  93. : (trace        (s - )
  94.         debugger-window  cr  ." ( " .s ." )"
  95.         #out @ 4 + th fc and to-column
  96.         r@ token@ >name  #columns 1 - over c@ -
  97.         dup #out @ - 4 / 1- 0 max 0
  98.         1 linecounter +! linecounter @ 2 > if ?do ."  .  " loop linecounter off else 2drop then
  99.         to-column .id
  100.         step? @ key? or
  101.         if      step? on  res off .dkeyinfo key upc
  102.                 case [char] D of r@ token@ (debug                        endof
  103.                      [char] U of rp@ cell+ @ up1                          endof
  104.                      [char] C of step? @ not step? ! .dcont              endof
  105.                      [char] F of .dresume forth-window
  106.                                 begin interpret-line res @ until
  107.                                 debugger-window .dtitle            endof
  108.                      [char] G of cr <ip off  ip> off .dtitle             endof
  109.                      [char] Q of .dtitle forth-window cr ." unbug" abort endof
  110.                 endcase
  111.         then
  112.         forth-window pnext ;
  113. ' (trace  'debug token!
  114.  
  115. only forth also  hidden also  bug also forth definitions
  116.  
  117. : debug         \ name (s -- )
  118.         ' (debug ;
  119. : resume        (s -- )         res on  pnext  ;
  120. : step          (s -- )         step? on  ;
  121. : trace         (s -- )         step? off ;
  122. : debug-off     (s -- )
  123.         unbug here  low-dictionary-adr  fast-next slow-next? off
  124.         (pos? one-window at-xy
  125.         save-status token@ is status ;
  126.  
  127. only forth also definitions
  128. decimal
  129.